Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d18/opbonus.arc/FLEXHDR.ARC/FLEXHDR.PAS

Pascal/Delphi Source File | 1991-03-20 | 6KB | 207 lines

(*
  Demonstrates how to derive a new header type from the existing HeaderNode
  object. This unit provides a simple header type that uses FlexWrite instead
  of FastWrite, so that headers can appear in more than one color. Headers can
  be positioned at custom locations with InitCustom or at standard locations
  (like top center, etc.) with Init.

  Written 3/9/90.
*)

{$S-,R-,V-,I-,B-,F+,O+,A-}

{Conditional defines that may affect this unit}
{$I OPDEFINE.INC}

unit FlexHdr;
  {-Demonstrate how to add new header types for windows}

interface

uses
  OpRoot,
  OpString,
  OpCrt,
  {$IFDEF UseMouse}
  OpMouse,
  {$ENDIF}
  OpFrame;

const
  otFlexHeader = 2999;            {Stream code for FlexHeader}
  veFlexHeader = 00;              {Stream version for FlexHeader}

type
  FlexHeaderPtr  = ^FlexHeader;
  FlexHeader     =
    object(HeaderNode)
      flColor : FlexAttrs;        {Flex attributes in color mode}
      flMono : FlexAttrs;         {Flex attributes in mono mode}
      flDummy : record end;       {Makes stream routines cleaner}
      constructor Init(Name : String;
                       var AttrColor, AttrMono : FlexAttrs;
                       hType : HeaderPosType;
                       FPtr : FramePtr);
        {-Initialize a FlexHeader in a position relative to a frame}
      constructor InitCustom(Name : String;
                             var AttrColor, AttrMono : FlexAttrs;
                             DX, DY : Integer;
                             hPosn : FrameCharType);
        {-Initialize header node}
      procedure Draw(XL, YL, XH, YH : Byte; Framed : Boolean); virtual;
        {-Draw one header node}
      procedure Update(XL, YL, XH, YH : Byte; Framed : Boolean); virtual; {!!.01}
        {-Adjust internal string and coords based on given frame coords}
      procedure Coordinates(XL, YL, XH, YH : Byte;
                            var heXL, heYL, heXH, heYH : Byte); virtual;
        {-Return the absolute coordinates of a rectangle surrounding header}

      {... stream methods ...}
      constructor Load(var S : IdStream);
        {-Load from stream}
      procedure Store(var S : IdStream);
        {-Store to stream}
    end;

  procedure FlexHeaderStream(SPtr : IdStreamPtr);
    {-Register types needed for streams containing FlexHeaders}

  {======================================================================}

implementation

  constructor FlexHeader.Init(Name : String;
                              var AttrColor, AttrMono : FlexAttrs;
                              hType : HeaderPosType;
                              FPtr : FramePtr);
    {-Initialize a FlexHeader in a position relative to a frame}
  begin
    if hType = heSpan then
      {Spans not allowed here}
      Fail;
    flColor := AttrColor;
    flMono := AttrMono;
    if not HeaderNode.Init(Name, AttrColor[0], AttrMono[0],
                           0, 0, hType, frTL) then
      Fail;
    with FPtr^ do
      Update(frXL, frYL, frXH, frYH, frFramed);
  end;

  constructor FlexHeader.InitCustom(Name : String;
                                    var AttrColor, AttrMono : FlexAttrs;
                                    DX, DY : Integer;
                                    hPosn : FrameCharType);
    {-Initialize header node}
  begin
    flColor := AttrColor;
    flMono := AttrMono;
    if not HeaderNode.Init(Name, AttrColor[0], AttrMono[0],
                           DX, DY, heCustom, hPosn) then
      Fail;
  end;

  procedure FlexHeader.Update(XL, YL, XH, YH : Byte; Framed : Boolean);
    {-Adjust internal string and coords based on given frame coords}
  var
    SaveLen : Byte;
  begin
    SaveLen := Byte(heName^[0]);
    Byte(heName^[0]) := FlexLen(heName^);
    HeaderNode.Update(XL, YL, XH, YH, Framed);
    Byte(heName^[0]) := SaveLen;
  end;

  procedure FlexHeader.Draw(XL, YL, XH, YH : Byte; Framed : Boolean);
    {-Draw one header node}
  var
    X : Integer;
    Y : Integer;
    {$IFDEF UseMouse}
    MOn : Boolean;
    {$ENDIF}
  begin
    if Disabled then
      Exit;
    case hePosn of
      frTL, frTT, frBB, frLL, frRR :
        begin
          X := XL; Y := YL;
        end;
      frBL :
        begin
          X := XL; Y := YH;
        end;
      frTR :
        begin
          X := XH; Y := YL;
        end;
      frBR :
        begin
          X := XH; Y := YH;
        end;
    end;
    inc(Y, heDY);
    inc(X, heDX);
    if (Y < 1) or (X < 1) then
      Exit;

    {$IFDEF UseMouse}
    HideMousePrim(MOn);
    {$ENDIF}

    {No clipping support}
    if UseColor then
      FlexWrite(heName^, Y, X, flColor)
    else
      FlexWrite(heName^, Y, X, flMono);

    {$IFDEF UseMouse}
    ShowMousePrim(MOn);
    {$ENDIF}
  end;

  procedure FlexHeader.Coordinates(XL, YL, XH, YH : Byte;
                                   var heXL, heYL, heXH, heYH : Byte);
    {-Return the absolute coordinates of a rectangle surrounding header}
  var
    SaveLen : Byte;
  begin
    SaveLen := Byte(heName^[0]);
    Byte(heName^[0]) := FlexLen(heName^);
    HeaderNode.Coordinates(XL, YL, XH, YH, heXL, heYL, heXH, heYH);
    Byte(heName^[0]) := SaveLen;
  end;

  constructor FlexHeader.Load(var S : IdStream);
    {-Load from stream}
  begin
    if not HeaderNode.Load(S) then
      Fail;
    S.ReadRange(flColor, flDummy);
    if S.PeekStatus <> 0 then begin
      Done;
      Fail;
    end;
  end;

  procedure FlexHeader.Store(var S : IdStream);
    {-Store to stream}
  begin
    HeaderNode.Store(S);
    S.WriteRange(flColor, flDummy);
  end;

  procedure FlexHeaderStream(SPtr : IdStreamPtr);
    {-Register types needed for streams containing FlexHeaders}
  begin
    DoubleListStream(SPtr);
    with SPtr^ do begin
      RegisterType(otHeaderNode, veHeaderNode,
                   TypeOf(HeaderNode), @HeaderNode.Store, @HeaderNode.Load);
      RegisterType(otFlexHeader, veFlexHeader,
                   TypeOf(FlexHeader), @FlexHeader.Store, @FlexHeader.Load);
    end;
  end;
end.